home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1998 July / EnigmA AMIGA RUN 29 (1998)(G.R. Edizioni)(IT)[!][issue 1998-07 & 08].iso / earkit / news / thor / hd-install / thor.lha / rexx / AddUser.thor next >
Text File  |  1997-08-29  |  11KB  |  359 lines
  1. /*
  2.  * $VER: AddUser.thor v1.42 (29.8.97)
  3.  *
  4.  * by Magne Østlyngen and Eirik Synnes
  5.  *
  6.  * Adds the sender or any recipient of the current or multiselected
  7.  * messages to the user database.
  8.  *
  9.  * New in 1.3:
  10.  *  Messages can be multiselected
  11.  *  Abiity to add addresses from all From:, To: and Cc: header lines
  12.  *  Now handles double quotes and asterixes
  13.  *  Some minor bugfixes and improvements
  14.  *
  15.  * New in 1.4:
  16.  *  Some debug info was left in 1.3 making the script useless :/
  17.  *  Replaced the four confirmation requesters with one listview
  18.  *  Existing entries in the user database can optionally be replaced
  19.  *
  20.  * New in 1.41:
  21.  *  Put the "Cancel" choice in the editing requesters back in
  22.  *  The script would always quit after adding one user
  23.  *
  24.  * New in 1.42:
  25.  *  Fixed some remaining problems with double quotes and asterixes
  26.  *
  27.  */
  28.  
  29. options results
  30. options failat 31
  31.  
  32. msglist.count = 0
  33.  
  34. p = ' ' || address() || ' ' || show('P',,)
  35. thorport = pos(' THOR.',p)
  36.  
  37. if thorport > 0 then thorport = word(substr(p,thorport+1),1)
  38. else
  39. do
  40.     say 'No THOR port found!'
  41.     exit 10
  42. end
  43.  
  44. if ~show('p', 'BBSREAD') then do
  45.     address command
  46.     "run >nil: `GetEnv THOR/THORPath`bin/LoadBBSRead"
  47.     "WaitForPort BBSREAD"
  48. end
  49.  
  50. address(thorport)
  51. 'CURRENTSYSTEM STEM 'cursys
  52. if (rc ~= 0) then do
  53.     if (rc = 1) then do
  54.         'REQUESTNOTIFY "No system open." "Ok"'
  55.         exit(0)
  56.     end
  57.     else do
  58.         'REQUESTNOTIFY "CURRENTSYSTEM failed: 'THOR.LASTERROR'" "Ok"'
  59.         exit(0)
  60.     end
  61. end
  62.  
  63. if (cursys.CONFNAME = '') then do
  64.     'REQUESTNOTIFY "No conference open." "Ok"'
  65.     exit(0)
  66. end    
  67.  
  68.  
  69. 'GETMSGLISTSELECTED STEM 'msglist
  70. select
  71.     when (rc = 3 | rc = 5) then do
  72.         'CURRENTMSG STEM 'msg
  73.         if rc~=0 then do
  74.             REQUESTNOTIFY '"CURRENTMSG failed: '||THOR.LASTERROR||'"' '"Ok"'
  75.             exit
  76.         end
  77.         msglist.1 = msg.msgnr; msglist.count = 1
  78.         drop msg.
  79.     end
  80.     when (rc = 0) then nop
  81.     otherwise do
  82.         'REQUESTNOTIFY "GETMSGLISTSELECTED failed: 'THOR.LASTERROR'" "Ok"'
  83.         exit(0)
  84.     end
  85. end
  86.  
  87. do i = 1 to msglist.count
  88.     drop new. userlist. head. text.
  89.  
  90.     cancelled = 0
  91.  
  92.     address(bbsread)
  93.     'READBRMESSAGE "'||cursys.bbsname||'" "'||cursys.confname||'" 'msglist.i' HEADSTEM 'head' TEXTSTEM 'text
  94.     if (rc ~=0) then do
  95.         address(thorport)
  96.         'REQUESTNOTIFY "READBRMESSAGE failed on message ' || msglist.i || ':\n' || BBSREAD.LASTERROR || '" "Ok"'
  97.         exit
  98.     end
  99.  
  100.     call parseaddr(1, 1)
  101.  
  102.     do j = 1 to addrs.count
  103.         userlist.j = left(addrs.j.name, 30) || ' '
  104.         userlist.j = userlist.j || '<' || addrs.j.addr || '>'
  105.     end
  106.     userlist.count = addrs.count
  107.  
  108.     do while ~(cancelled)
  109.         address(thorport)
  110.         'REQUESTLIST INSTEM 'userlist' TITLE "Select user to add or Cancel to go on" SIZEGADGET'
  111.  
  112.         select
  113.             when (rc > 5) then do
  114.                 'REQUESTNOTIFY "REQUESTLIST failed: ' || THOR.LASTERROR || '" "Ok"'
  115.                 exit(0)
  116.             end
  117.  
  118.             when (rc = 5) then cancelled = 1
  119.  
  120.             otherwise do
  121.                 selected = result
  122.                 do j = 1 to addrs.count while selected = result
  123.                     if selected = userlist.j then selected = j
  124.                 end
  125.  
  126.                 new.name      = addrs.selected.name
  127.                 new.address   = addrs.selected.addr
  128.                 new.comment.1 = ''
  129.                 new.alias     = ''
  130.                 finished      = 0
  131.  
  132.                 do while ~(finished)
  133.  
  134.                     useredit.1 = 'Add this new user'
  135.                     useredit.2 = ''
  136.                     useredit.3 = 'Name:  ' || new.name
  137.                     useredit.4 = 'Addr:  ' || new.address
  138.                     useredit.5 = 'Alias: ' || new.alias
  139.                     useredit.6 = 'Comm:  ' || new.comment.1
  140.                     useredit.count = 6
  141.  
  142.                     'REQUESTLIST INSTEM 'useredit' TITLE "Edit user" SIZEGADGET'
  143.                     choice = result
  144.  
  145.                     choice = result
  146.                     do j = 1 to useredit.count while choice = result
  147.                         if choice = useredit.j then choice = j
  148.                     end
  149.  
  150.                     select
  151.                         when (rc > 5) then do
  152.                             'REQUESTNOTIFY "REQUESTLIST failed: ' || THOR.LASTERROR || '" "Ok"'
  153.                             exit(0)
  154.                         end
  155.  
  156.                         when (rc = 5) then finished = 1
  157.  
  158.                         when (rc = 0) & (choice = 3) then do
  159.                             'REQUESTSTRING TITLE="Enter Name:" BT="Ok|Cancel" ID="'||addasterix(new.name)||'" MAXCHARS=100'
  160.                             if rc = 0 then new.name = result
  161.                             else if (rc > 5) then do
  162.                                 'REQUESTNOTIFY "REQUESTSTRING failed: ' || THOR.LASTERROR || '" "Ok"'
  163.                                 exit(0)
  164.                             end
  165.                         end
  166.  
  167.                         when (rc = 0) & (choice = 4) then do
  168.                             REQUESTSTRING 'TITLE="Enter Address:" BT="Ok|Cancel" ID="'||addasterix(new.address)||'" MAXCHARS=100'
  169.                             if rc = 0 then new.address = result
  170.                             else if (rc > 5) then do
  171.                                 'REQUESTNOTIFY "REQUESTSTRING failed: ' || THOR.LASTERROR || '" "Ok"'
  172.                                 exit(0)
  173.                             end
  174.                         end
  175.  
  176.                         when (rc = 0) & (choice = 5) then do
  177.                             'REQUESTSTRING TITLE="Enter Alias:" ID="' || addasterix(new.alias) || '" BT="Ok|Cancel" MAXCHARS=100'
  178.                             if rc = 0 then new.alias = result
  179.                             else if (rc > 5) then do
  180.                                 'REQUESTNOTIFY "REQUESTSTRING failed: ' || THOR.LASTERROR || '" "Ok"'
  181.                                 exit(0)
  182.                             end
  183.                         end
  184.  
  185.                         when (rc = 0) & (choice = 6) then do
  186.                             REQUESTSTRING 'TITLE="Enter Comment:" ID="' || addasterix(new.comment.1) || '" BT="Ok|Cancel" MAXCHARS=100'
  187.                             if rc = 0 then new.comment.1 = result
  188.                             else if (rc > 5) then do
  189.                                 'REQUESTNOTIFY "REQUESTSTRING failed: ' || THOR.LASTERROR || '" "Ok"'
  190.                                 exit(0)
  191.                             end
  192.                         end
  193.  
  194.                         when (rc = 0) & (choice = 1) then do
  195.                             if new.comment.1 = "" then new.comment.count = 0; else new.comment.count = 1
  196.                             deluser = 0; drop userseach.
  197.  
  198.                             address(bbsread)
  199.                             'SEARCHBRUSER BBSNAME "'cursys.bbsname'" STEM 'usersearch' SEARCH "' || addasterix(new.address) || '" ADDRESS'
  200.                             if (rc ~= 0) then do
  201.                                 address(thorport)
  202.                                 'REQUESTNOTIFY "SEARCHBRUSER failed: ' || BBSREAD.LASTERROR || '" "Ok"'
  203.                                 exit(0)
  204.                             end
  205.                             address(thorport)
  206.                             if (result > 0) then do
  207.                                 'REQUESTNOTIFY "A user with this address already\nexists. Do you want to replace\nthis user?" "Yes|No"'
  208.                                 if (result > 0) then deluser = 1
  209.                             end
  210.                             firstsearch = usersearch.1.usernr
  211.  
  212.                             address(bbsread)
  213.                             'SEARCHBRUSER BBSNAME "'cursys.bbsname'" STEM 'usersearch' SEARCH "' || addasterix(new.name) || '" NAME'
  214.                             if (rc ~= 0) then do
  215.                                 address(thorport)
  216.                                 'REQUESTNOTIFY "SEARCHBRUSER failed: ' || BBSREAD.LASTERROR || '" "Ok"'
  217.                                 exit(0)
  218.                             end
  219.                             if (result > 0) & ~(deluser) & ~(usersearch.1.usernr = firstsearch) then do
  220.                                 address(thorport)
  221.                                 'REQUESTNOTIFY "A user with this name already\nexists. Do you want to replace\nthis user?" "Yes|No"'
  222.                                 if (result > 0) then deluser = 1
  223.                             end
  224.  
  225.                             if (deluser) then do
  226.                                 address(bbsread)
  227.                                 'WRITEBRUSER "'cursys.bbsname'" UPDATEUSERNR 'usersearch.1.USERNR' DELETEUSER'
  228.                                 if (rc ~= 0) then do
  229.                                     address(thorport)
  230.                                     'REQUESTNOTIFY "WRITEBRBRUSER failed: ' || BBSREAD.LASTERROR || '" "Ok"'
  231.                                     exit(0)
  232.                                 end
  233.                             end
  234.  
  235.                             address(bbsread)
  236.                             'WRITEBRUSER "' || cursys.bbsname || '" STEM 'new
  237.                             if (rc ~= 0) then do
  238.                                 address(thorport)
  239.                                 'REQUESTNOTIFY "WRITEBRUSER failed: ' || BBSREAD.LASTERROR || '" "Ok"'
  240.                                 exit(0)
  241.                             end
  242.                             finished = 1
  243.                         end
  244.  
  245.                         otherwise nop
  246.                     end /* select */
  247.                 end /* ~(finished) */
  248.             end /* otherwise */
  249.         end /* select */
  250.     end /* ~(cancelled) */
  251. end
  252.  
  253. syntax:
  254. break_c:
  255. halt:
  256.  
  257. exit
  258.  
  259.  
  260.  /****************************************************************************
  261. *************** Put addresses and names in a string into a stem ***************
  262.  ****************************************************************************/
  263.  
  264. parseaddr: procedure expose addrs. text. head.
  265.            parse arg checkfromaddr, checkcc
  266.  
  267. i = 1; acnt = 0; usedhead = 0; drop addrs.
  268.  
  269. if checkfromaddr = 1 then do
  270.     acnt = acnt + 1; addrs.acnt.name = head.FROMNAME
  271.     if (symbol('head.FROMADDR') = 'VAR') then addrs.acnt.addr = head.FROMADDR
  272.     else addrs.acnt.addr = ''
  273. end
  274.  
  275. if (symbol('head.TOADDR') = 'VAR') & ~(index(head.TOADDR, ',') > 0) then do
  276.     acnt = acnt + 1; addrs.acnt.name = ''; addrs.acnt.cc = 0; usedhead = 1
  277.     addrs.acnt.addr = head.TOADDR
  278.     if (symbol('head.TONAME') = 'VAR') then addrs.acnt.name = head.TONAME
  279. end
  280.  
  281. if (symbol('text.COMMENT.COUNT') = 'VAR') then if (text.COMMENT.COUNT > 0) then do while i <= text.COMMENT.COUNT
  282.     thiscc = 0
  283.  
  284.     if (checkcc = 1) & (upper(subword(text.COMMENT.i, 1, 1)) = 'CC:') then thiscc = 1
  285.  
  286.     if (thiscc) | (upper(subword(text.COMMENT.i, 1, 1)) = 'TO:') then do
  287.         addrs = subword(text.COMMENT.i, 2)
  288.         do forever
  289.             addrs = strip(addrs, 'B', ' ' || '09'x)
  290.  
  291.             offset = 1
  292.             do forever
  293.                 length = index(substr(addrs, offset), ','); if (length = 0) then length = length(addrs) - offset + 1
  294.                 thisaddr = strip(substr(addrs, offset, length), 'B', ', ');
  295.                 acnt = acnt + 1; addrs.acnt.addr = ''; addrs.acnt.name = ''
  296.                 if (thiscc) then addrs.acnt.cc = 1; else addrs.acnt.cc = 0
  297.  
  298.                 if (words(thisaddr) = 1) then addrs.acnt.addr = strip(thisaddr, 'B', '<>()')
  299.                 else if (index(thisaddr, '<') > 0) then do
  300.                     addrstart  = index(thisaddr, '<')
  301.                     addrlength = index(substr(thisaddr, addrstart), '>')
  302.                     addrs.acnt.addr = strip(substr(thisaddr, addrstart + 1, addrlength), 'B', '> ')
  303.                     addrs.acnt.name = strip(delstr(thisaddr, addrstart, addrlength), 'B', ' "' || '27'x)
  304.                 end
  305.                 else do j = 1 to words(thisaddr)
  306.                     thispart = strip(subword(thisaddr, j, 1), 'B', '<>" ' || '27'x)
  307.                     if (index(thispart, '@') > 0) then addrs.acnt.addr = thispart
  308.                     else addrs.acnt.name = addrs.acnt.name || thispart || ' '
  309.                 end
  310.  
  311.                 if ~(thiscc) & (usedhead) & (addrs.acnt.addr = addrs.1.addr) & (addrs.acnt.name = addrs.1.name) then do
  312.                     drop addrs.acnt.; acnt = acnt - 1
  313.                 end
  314.  
  315.                 if (offset + length >= length(addrs)) then break
  316.                 offset = offset + length
  317.             end
  318.  
  319.             j = i + 1; if ~((c2d(left(text.COMMENT.j, 1)) = 9) | (c2d(left(text.COMMENT.j, 1)) = 32)) then break
  320.             i = i + 1; addrs = text.COMMENT.i
  321.         end
  322.     end
  323.     i = i + 1
  324. end
  325.  
  326. addrs.COUNT = acnt
  327.  
  328. return(0)
  329.  
  330.  
  331.  /****************************************************************************
  332. ****** Insert asterix (*) before double quotes (") and existing asterixes *****
  333.  ****************************************************************************/
  334.  
  335. addasterix: procedure
  336.             parse arg str
  337.  
  338. if str = '' then return(str)
  339.  
  340. lastfound = 0; found = index(str, '*')
  341. do while found > lastfound
  342.     secondpart = substr(str, found + length('*'))
  343.     firstpart = substr(str, 1, length(str) - length(substr(str, found)))
  344.     str = firstpart || '**' || secondpart
  345.     lastfound = found + length('**')
  346.     found = index(str, '*', lastfound)
  347. end
  348.  
  349. lastfound = 0; found = index(str, '"')
  350. do while found > lastfound
  351.     secondpart = substr(str, found + length('"'))
  352.     firstpart = substr(str, 1, length(str) - length(substr(str, found)))
  353.     str = firstpart || '*"' || secondpart
  354.     lastfound = found + length('*"')
  355.     found = index(str, '"', lastfound)
  356. end
  357.  
  358. return(str)
  359.